perm filename RESPC.F4[PAG,LCS]2 blob sn#365847 filedate 1978-07-01 generic text, type T, neo UTF8
00100		SUBROUTINE RESPC
00200		COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00300		1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00400		1 RCLEF(0/7) /IVV/IV(1)
00500		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00600	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00700		COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00800		1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
00900	C  INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01000	      DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01100		1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01200		INTEGER DUMMY
01300		COMMON /PX/PN(1) /Q/Q(1)
01400		1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01500		1 /KBAR/KBAR(1) /RSP/KNM(20),ENDLN,KQ,NAME,NMPG,SPCNT
01600		DATA FIB/.8/  ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01700		1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/
01800	C  RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
01900		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
02000		1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
02100		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02200		1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02300		1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02400		1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02500	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
02600	CC	DATA JXYZ/1/
02700	
02800		IF(NMPG.NE.'PAGEA')GO TO 2000
02900	CC	NPZ='PAGEZ'
03000	CC	NPZF='PAGFZ'
03100	CC	NPZG='PAGGZ'
03200	C SHOULD HANDLE UP TO 104 INPUT FILES.  ADD HERE AND LATER FOR MORE RANGE.
03300		RNEXT=0
03400	2000	SPCNT=1.0
03500	CC	DO 2001 K=1,JXYZ
03600	CC2001	RN(K)=0
03700	C MUST ZERO NN AND MM ARRAYS, ETC.
03800		JX=0
03900		JCEN=0
04000	C  FLAG FOR CENTERED RESTS.
04100		XT=0
04200		PX=0
04300		CALL SHFT1(KQ)
04400		KK=L
04500	CC	TYPE 3001,L
04600	C  DELETES EXTRA BAR LINES, ETC.
04700		IF(IPG)CALL RESTS
04800	C???	IF(N)RETURN 
04900	C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
05000	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
05100		CALL SHIFT
05200	C  L=NUMBER OF ITEMS FOR RHY RECONS.
05300		JJ2=L+2
05400	C FOR WDCNT IN .PAG FILE
05500		N=0
05600		S=-100
05700		R=0
05800		KCLEF=0
05900		NOGRCE=-1
06000	C  GRACE NOTE FLAG
06100		TTT=0
06200	C FOR IRREG. NUMS. OF STAVES.
06300	
06400		DO 601 K=1,L
06500		R=CODEN(KPN,K,Q,J)
06600		RZ=Q(J)
06700	CX	J=KPN(K)
06800	CC	N=N+1
06900	CC	NN(N)=0
07000	CC	MM(N)=J+3
07100		CALL MMNN(3)
07200	CX	R=Q(J+1)
07300		IF(R.GT.2)GO TO 1801
07400		IF(Q(J+2).GT.TTT)TTT=Q(J+2)
07500	C FINDS HIGHEST STAFF NUM.  NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
07600		IF(R.NE.1)GO TO 2801
07700		IF(RZ.LT.7)GO TO 601
07800		IF(Q(J+9).GT..05)GO TO 702
07900		IF(Q(J+9).EQ.0)GO TO 601
08000	CC	IF(Q(J+8).EQ.1000)GO TO 601
08100	C  SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
08200		NOGRCE=0
08300		GO TO 601
08400	CCC2801	IF(R.NE.2)GO TO 1801
08500	2801	IF(RZ.NE.7)GO TO 3801
08600	C DELETE ALL UP TO LABEL 1801 LATER.  NEW CENTERED REST FEATURE. 5/29/78
08700		NN(N)=R
08800		GO TO 688
08900	3801	IF(RZ.LT.5)GO TO 601
09000		IF(IPG)GO TO 1801
09100		IF(RZ.LT.6)GO TO 1801
09200		RS=Q(J+3)
09300	C GET POS. OF CENTERED WHOLE REST
09400		TT=0
09500		B=Q(J+2)
09600	C GET THE STAFF NUM.
09700		DO 602 M=1,L
09800		T=CODEN(KPN,M,Q,JJ)
09900		A=Q(JJ+3)
10000	C GET POS. OF ITEM
10100		IF(A.GT.RS)GO TO 602
10200	C JUMP IF ITEM IS TO RIGHT OF REST
10300		IF(T.NE.4)GO TO 602
10400	C IS THE ITEM A BAR LINE
10500		IF(A.GT.TT)TT=A
10600	C FINDS BAR LINE CLOSEST TO LEFT OF REST
10700	602	CONTINUE
10800	C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
10900		T=20000
11000		A=20000
11100	C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
11200		DO 613 M=1,L
11300		IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
11400		IF(Q(JJ).LT.7)GO TO 609
11500	C SKIP IF RHYTH NOT IN P9
11600		IF(Q(JJ+9).LT..05)GO TO 613
11700	C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
11800	609	B=Q(JJ+3)
11900	C POS. OF ITEM
12000		X=B-TT
12100		IF(X)GO TO 613
12200	C JUMP IF ITEM IS TOO FAR TO LEFT
12300		IF(X.GT.A)GO TO 613
12400		A=X
12500		T=B
12600	C T = POS OF NOTE OR REST NEAREST BAR, ETC.
12700	613	CONTINUE
12800		IF(T.NE.20000)GO TO 612
12900	C JUMP IF NOTE OR REST FOUND
13000		JCEN=-1
13100		GO TO 1801
13200	612	Q(J+3)=T
13300	C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
13400	C  MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
13500	C  THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
13600	1801	IF(R.LT.4)GO TO 702
13700		IF(R.EQ.17)GO TO 1702
13800		IF(R.EQ.18)GO TO 1702
13900		IF(R.LE.7)GO TO 30
14000		IF(R.NE.44)GO TO 601
14100		IF(RZ.EQ.2)GO TO 601
14200	C RZ=2= BAR LINE ON UPPER STAFF
14300		IF(Q(J+6).EQ.0)GO TO 601
14400		IF(Q(J+5).EQ.0)GO TO 601
14500	C  GETS LEFT END OF LINES, CRESC., DASHES.
14600		GO TO 604
14700	30	IF(R.NE.7)GO TO 605
14800		IF(RZ.LT.5)GO TO 604
14900	C JUMP FOR STANDARD TRILL
15000		RS=Q(J+7)
15100		IF(RS.EQ.1)GO TO 604
15200		IF(ABS(RS).GE.3)GO TO 604
15300	C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
15400		GO TO 601
15500	605	IF(R.NE.4)GO TO 604
15600		IF(RZ.LE.3)GO TO 702
15700	C JUMP IF IT IS A BAR LINE
15800	CC	IF(RZ.LT.4)GO TO 601
15900		IF(Q(J+6).NE.0)GO TO 604
16000	C GO GET OTHER POS OF LINE
16100		GO TO 601
16200	1702	IF(Q(J+4).NE.0)GO TO 601
16300		IF(Q(J+2).NE.0)GO TO 601
16400	C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
16500	702	NN(N)=R 
16600		GO TO 601
16700	C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
16800	604	CALL MMNN(6)
16900	C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
17000		IF(R.NE.6)GO TO 601
17100	C NEXT FOR BEAMS
17200		IF(RZ.LT.8)GO TO 608
17300		IF(Q(J+10).EQ.0)GO TO 608
17400		IF(Q(J+8))GO TO 608
17500	C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
17600		IF(Q(J+7).GT.0)CALL MMNN(8)
17700	C NEXT SHIFTS P8 OF COMPOSITE BEAMS
17800	608	IF(RZ.LT.7)GO TO 601
17900		IF(Q(J+7))GO TO 688
18000	C  P7 IS NEG FOR TREMOLO
18100		IF(Q(J+8).EQ.0)GO TO 601
18200	C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
18300	688	IF(Q(J+9).GT.0)CALL MMNN(9)
18400	C FOUND A POS. IN P9
18500	601	CONTINUE
18600		KPG=TTT+1
18700	C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
18800	
18900	C NEXT SORTS THE POINTS
19000	6000	J=1
19100	610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
19200		CALL EXCHG(MM(J),NN(J))
19300	C  ABOVE EXCHGS --(J) AND --(J+1)
19400		IF(J.EQ.1)GO TO 710
19500		J=J-1
19600		GO TO 610
19700	710	J=J+1
19800		IF(J.LT.N)GO TO 610
19900	C NOW ALL SORTED
20000		CALL FNDEND(R)
20100		CALL SHFTQ(R)
20200	C  SHIFTS TO PROPER HORIZ. POS.
20300		IF(IPG)CALL RESTP
20400	C  RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS.
20500		IF(N.LE.0)GO TO 122
20600	C N IS NEG IF ONLY RESTS ON THIS LINE.  GO BACK.
20700	
20800		DO 119 K=1,150
20900	119	HH(K)=0
21000	C  HH ARRAY WILL HOLD FINAL COMPOSITE.
21100		G(1)=0
21200		E(1)=0
21300		F(1)=0
21400		RN(1500)=0
21500		RN(2500)=0
21600		ST=0
21700	C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
21800	C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
21900		KE=0
22000		J=1000
22100	933	JJ=1500
22200		JJJ=2000
22300		T=0
22400		M=0
22500		A=0
22600		B=0
22700	
22800		DO 33 K=1,N
22900		IF(NORH(KK))GO TO 33
23000	CC	KK=NN(K)
23100	CC	IF(KK.EQ.0)GO TO 33
23200	CC	IF(KK.EQ.4)GO TO 2133
23300	CC	IF(KK.EQ.17)GO TO 2133
23400	C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
23500	CC	IF(KK.EQ.18)GO TO 2133
23600	CC	IF(KK.GT.2)GO TO 33
23700	2133	LL=MM(K)-3
23800		IF(KK.LE.2)GO TO 1133
23900		RH=.01
24000	C RHYTHMIC VALUE OF BARLINE, METER, KSIG
24100	CCC	IF(KK.NE.4)RH=.6
24200		GO TO 3133
24300	1133	IF(Q(LL+2).NE.ST)GO TO 33
24400	C JUMP IF NOT ON RIGHT STAFF
24500		RA=9
24600		IF(KK.EQ.2)RA=7
24700		IF(Q(LL).LT.RA-2)GO TO 33
24800	C JUMP IF WDCNT IS TOO SHORT
24900		IF(KK.EQ.1)GO TO 433
25000		IF(Q(LL).LT.6)GO TO 433
25100	C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
25200		RZ=Q(LL+8)
25300	C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
25400		IF(RZ.LE.0)GO TO 433
25500		Q(LL+7)=3
25600	C 3 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST
25700		IF(RZ.LT.8)GO TO 433
25800		Q(LL+5)=-3
25900	C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
26000		RZ=IFIX(RZ/2.0)+1.0
26100		IF(RZ.GT.6)RZ=6
26200	C LIMIT OF 8 ON RHYTH VAL.
26300		Q(LL+7)=RZ
26400	433	RH=Q(LL+IFIX(RA))
26500		IF(RH.EQ.0)GO TO 33
26600	3133	RZ=Q(LL+3)
26700		IF(ZERO(RZ,A).EQ.0)GO TO 133
26800	C  JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
26900		RRH=RH
27000	C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
27100		TT=T
27200	C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
27300		J=J+1
27400	C UPDATE COUNTER IN POSITION ARRAY
27500		T=T+RH
27600	C ADD TO TOTAL RHYTHM
27700		RN(J)=T
27800		A=Q(LL+3)
27900	C SAVE POS. OF THIS NOTE.
28000		GO TO 33
28100	133	IF(RH.EQ.RHH)GO TO 33
28200	C  IGNORE 2ND RHYTH IF SAME AS FIRST
28300		IF(ZERO(RZ,B).EQ.0)GO TO 333
28400	C JUMP IF A THIRD DIFFERENT  RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
28500		TTT=TT
28600	C SAVE TOTAL RHYTHM TO THIS POINT.
28700		TT=TT+RH
28800		JJ=JJ+1
28900	C UPDATE COUNTER FOR 2ND ARRAY
29000		RN(JJ)=TT
29100		RRRH=RH
29200		B=A
29300		GO TO 33
29400	333	IF(RH.EQ.RRRH)GO TO 33
29500		TTT=TTT+RH
29600		JJJ=JJJ+1
29700		RN(JJJ)=TTT
29800	33	CONTINUE
29900	C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
30000		IF(ST.NE.0)GO TO 733
30100		KE=J-999
30200	C TOTAL NUM OF RHYTHMS ON STAFF1.
30300	CC	IF(JPG.EQ.0)GO TO 2233
30400		IF(KPG.LE.1)GO TO 2233
30500	C KPG=0=PARTS;    =1=PAGE, 1 STAFF
30600	C  JUMP IF ONLY ONE STAFF
30700	C****733	KF=J-2499
30800	C KF=NUM OF RHYTHMS ON NEXT STAFF.  **** NEVER USED ****
30900	733	ST=ST+1
31000		IF(ST.GT.1)GO TO 833
31100	C JUMP IF ALL STAVES HAVE BEEN READ.
31200	1233	J=2500
31300		GO TO 933
31400	833	IF(J.NE.2500)GO TO 1533
31500	C  JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
31600	C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
31700	
31800	2233	CALL RLOOP(HH,E,KE)
31900	C FOR SINGLE STAFF OF RHYTHM
32000		KL=KE
32100		GO TO 1333
32200	1533	K=1
32300		L=1
32400		M=0
32500	19	KK=K
32600		LL=L
32700	1	SM=10000
32800		K=K+1
32900		IF(K.GT.KE)GO TO 10
33000	4	L=L+1
33100		Y=F(L)
33200		B=Y-F(L-1)
33300		IF(B.LT.SM)SM=B
33400	2	X=E(K)
33500		A=X-E(K-1)
33600	C  A AND B HAVE TRUE DURATIONS NOW
33700		IF(A.LT.SM)SM=A
33800	C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
33900		IF(ZERO(X,Y).EQ.0)GO TO 3
34000	C JUMP IF EQUAL RHYTHS
34100		IF(X.GT.Y)GO TO 4
34200		K=K+1
34300	C STEP FORWARD UNTIL X IS .GT. Y
34400		GO TO 2
34500	3	IF(K.NE.KK+1)GO TO 13
34600		IF(L.NE.LL+1)GO TO 14
34700		M=M+1
34800		G(M)=E(KK)
34900		GO TO 19
35000	13	IF(L.NE.LL+1)GO TO 15
35100		DO 16 J=KK,K-1
35200		M=M+1
35300	16	G(M)=E(J)
35400		GO TO 19
35500	14	DO 17 J=LL,L-1
35600		M=M+1
35700	17	G(M)=F(J)
35800		GO TO 19
35900	15	XM=SM-.001
36000		M=M+1
36100		P=E(KK)
36200		G(M)=P
36300	7	KK=KK+1
36400		LL=LL+1
36500		YM=SM*1.5
36600	C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
36700		S=P
36800		T=P
36900	27	A=E(KK)
37000		B=F(LL)
37100		IF(ZERO(A,B).EQ.0)GO TO 19
37200		X=ZERO(A,P)
37300		Y=ZERO(B,P)
37400	C  FUNCT. ZERO:  ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
37500		S=E(KK-1)
37600		T=F(LL-1)
37700	9	IF(A-S.LT.X-.01)X=ZERO(A,S)
37800		IF(B-T.LT.Y-.01)Y=ZERO(B,T)
37900		IF(A.GT.B+.01)GO TO 8
38000		B=A
38100		KK=KK+1
38200	62	IF(X.GT.YM)GO TO 5
38300		IF(X.EQ.0)GO TO 27
38400		P=P+SM
38500	25	M=M+1
38600		G(M)=P
38700		GO TO 27
38800	5	P=P+SM
38900		IF(P)GO TO 203
39000	C IF(P)ERROR
39100		IF(P.LT.B-.01)GO TO 5
39200		GO TO 25
39300	8	X=Y
39400		LL=LL+1
39500		GO TO 62
39600	10	M=M+1
39700		G(M)=E(KE)
39800	CC	TYPE 410,(E(K),K=1,KE)
39900	CC	TYPE 410,(F(K),K=1,KF)
40000	CC	TYPE 410,(G(K),K=1,M)
40100	CBCB	WRITE(21,410)(E(K),K=1,KE)
40200	CB	WRITE(21,410)(F(K),K=1,KF)
40300	CB	WRITE(21,410)(G(K),K=1,M)
40400	410	FORMAT(10F7.2)
40500	C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
40600	1033	JJ=1
40700		H(1)=0
40800		J=1
40900		K=2
41000		L=2
41100	511	IF(J.EQ.M)GO TO 911
41200		J=J+1
41300		X=G(J)
41400	1211	A=E(K)
41500		B=F(L)
41600		Y=ZERO(X,A)
41700		Z=ZERO(X,B)
41800		IF(A-B.GT..01)GO TO 1111
41900		IF(Y.EQ.0)GO TO 1311
42000		IF(X.LT.A-.01)GO TO 1111
42100		K=K+1
42200	1411	JJ=JJ+1
42300		H(JJ)=-A
42400		GO TO 1211
42500	1111	IF(Z.EQ.0)GO TO 1311
42600		IF(X.LT.B-.01)GO TO 1311
42700		L=L+1
42800		A=B
42900		GO TO 1411
43000	
43100	1311	JJ=JJ+1
43200		H(JJ)=X
43300		IF(Y.EQ.0)GO TO 611
43400		IF(Z.EQ.0)GO TO 711
43500		IF(ZERO(A,B).EQ.0)GO TO 511
43600		P=A
43700		IF(P.GT.B+.01)GO TO 811
43800		IF(P.GT.X+.01)GO TO 511
43900		K=K+1
44000		GO TO 1011
44100	811	P=B
44200		IF(P.GT.X+.01)GO TO 511
44300		L=L+1
44400	1011	JJ=JJ+1
44500		H(JJ)=-P
44600	C NON-SPACED RHYTHS ARE NEG.
44700		GO TO 511
44800	611	K=K+1
44900		IF(Z.GT.0)GO TO 511
45000	711	L=L+1
45100		GO TO 511
45200	911	IF(HH(2).EQ.0)GO TO 2011
45300		K=2
45400		J=2
45500		L=1
45600		HHH(1)=0
45700	1511	IF(J.GT.JJ)GO TO 1811
45800		P=H(J)
45900		A=ABS(P)
46000		B=ABS(HH(K))
46100		IF(ZERO(B,A).EQ.0)GO TO 1611
46200		IF(A.GT.B)GO TO 1711
46300		J=J+1
46400		GO TO 1911
46500	1711	P=HH(K)
46600		GO TO 2211
46700	1611	J=J+1
46800	2211	K=K+1
46900	1911	L=L+1
47000		HHH(L)=P
47100		GO TO 1511
47200	2011	CALL RLOOP(HH,H,JJ)
47300		KL=JJ
47400		GO TO 2111
47500	1811	CALL RLOOP(HH,HHH,L)
47600		KL=L
47700	2111	IF(ST.GE.KPG)GO TO 1333
47800		CALL RLOOP(E,G,M)
47900		KE=M
48000	C GO WAY BACK AND READ ANOTHER LINE.
48100		GO TO 1233
48200	1333	E(1)=0
48300		GO TO 2333
48400		TYPE 410,(HH(K),K=1,KL)
48500		WRITE(21,410)(HH(K),K=1,KL)
48600	2333	JD=1
48700	C JD IS COUNTER FOR DUMMY POSITIONS.
48800		DUMMY(1)=1
48900		ST=0
49000	183	B=0
49100		LL=2
49200	
49300		DO 181 K=1,N
49400		IF(NORH(L))GO TO 181
49500	C LOOK FOR DUMMY RHYTHMS.
49600		IF(L.LE.2)GO TO 2184
49700		RZ=.01
49800	C  RHYTHMIC VALUE OF BAR, METER, KSIG.  CHANGED TO ABS. SIZE LATER.
49900		GO TO 1184
50000	2184	LF=MM(K)
50100		IF(Q(LF-1).NE.ST)GO TO 181
50200	C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
50300		J=6
50400		IF(L.EQ.2)J=4
50500		RZ=Q(LF+J)
50600	1184	B=B+RZ
50700	184	V=ABS(HH(LL))
50800		IF(ZERO(B,V).GT.0)GO TO 182
50900	C FOUND RHYTH MATCH
51000		JD=JD+1
51100		DUMMY(JD)=LL
51200		LL=LL+1
51300		GO TO 181
51400	182	IF(B.LT.V-.01)GO TO 181
51500		LL=LL+1
51600		GO TO 184
51700	181	CONTINUE
51800		ST=ST+1
51900		IF(ST.LT.KPG)GO TO 183
52000	
52100	C NEXT SORT DUMMY ARRAY
52200		J=0
52300	185	DO 186 K=2,JD
52400		IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
52500		DO 188 LL=K,JD
52600	188	DUMMY(LL-1)=DUMMY(LL)
52700		JD=JD-1
52800		GO TO 185
52900	187	IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
53000		CALL EXCH(DUMMY(K),DUMMY(K-1))
53100		GO TO 185
53200	186	CONTINUE
53300	C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
53400		PX=0
53500		LF=0
53600		K=1
53700		V=0
53800	
53900	81	K=K+1
54000		IF(K.GT.KL)GO TO 1433
54100		B=HH(K)
54200		A=B-V
54300		V=B
54400		IF(V)GO TO 82
54500	85	W=V
54600		IF(A.GT.0.01)GO TO 89
54700	C  .GT. BECAUSE OF ROUND-OFF ERROR
54800		T=5
54900		IF(HH(K+1)-V.LE..01)T=2
55000		PX=PX+T
55100	C THIS FOR BARS, KSIG, METER
55200		GO TO 189
55300	89	PX=PX+14.0*EXP(ALOG(A)*0.5849624)
55400	C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5))  NOT FIBBONACI (1.618)
55500	CC89	PX=PX+PFIBX(A)
55600	189	E(K)=PX
55700		IF(LF.NE.0)GO TO 86
55800		GO TO 81
55900	82	LF=K
56000	83	K=K+1
56100		V=HH(K)
56200		IF(V)GO TO 83
56300		A=V-W
56400		GO TO 85
56500	86	LL=LF-1
56600		D=E(K)-E(LL)
56700	87	S=-HH(LF)-HH(LL)
56800		T=HH(K)-HH(LL)
56900		T=S/T
57000	C  THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
57100		E(LF)=E(LL)+D*T
57200		LF=LF+1
57300		IF(LF.NE.K)GO TO 87
57400		LF=0
57500		GO TO 81
57600	
57700	1433	GO TO 2433
57800		TYPE 410,(E(K),K=1,KL)
57900		WRITE(21,410)(E(K),K=1,KL)
58000	C  5 IS SPACE AFTER 1ST BARLINE
58100	2433	R8=RNEXT
58200	C POS OF 1ST BAR = END OF PREV. LINE
58300	     	IF(ENDLN.EQ.0)RNEXT=9
58400	C  MAKES ROOM FOR 1ST CLEF.
58500		KL=KL-1
58600		J=0
58700		R5=0
58800		KK=1
58900		JD=1
59000		W=0
59100		LF=0
59200	
59300		DO 80 K=1,N
59400		IF(NORH(L))GO TO 80
59500		A=Q(MM(K))
59600		IF(ZERO(A,W).EQ.0)GO TO 80
59700	C  SKIP IF SAME POS OF NOTE OR REST.
59800		W=A
59900		R7=R8
60000	190	J=J+1
60100		IF(J.LE.KL)GO TO 290
60200	203	FORMAT(' FOUND CENTERED WHOLE REST!')
60300		LL=0
60400		IF(JCEN.GE.0)GO TO 120
60500		TYPE 203
60600		GO TO 121
60700	120	W=LL
60800		A=0
60900		DO 124 K=1,N
61000		LF=NN(K)
61100		IF(LF.GT.2)GO TO 124
61200		IF(LF.EQ.0)GO TO 124
61300		KE=MM(K)
61400		IF(Q(KE-1).NE.W)GO TO 124
61500	C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
61600		JD=6
61700		IF(LF.EQ.2)JD=4
61800		A=A+Q(KE+JD)
61900	124	CONTINUE
62000		TYPE 123,LL,A
62100		LL=LL+1
62200		IF(LL.LT.KPG)GO TO 120
62300	123	FORMAT(' STF',I2,' =',F9.5,' QTRS')
62400	121	PAUSE' *****RHYTHM MISMATCH OR MISALIGNED NOTES*****'
62500		GO TO 90
62600	290	IF(DUMMY(JD).NE.J)GO TO 190
62700		JD=JD+1
62800	90 	R8=RNEXT+E(J)
62900		R4=R5
63000		R5=A
63100		X=(R8-R7)/(R5-R4)
63200		S=R7-R4*X
63300		DO 91 L=KK,K
63400		LL=MM(L)
63500	91	Q(LL)=S+X*Q(LL)
63600		KK=K+1
63700	80	CONTINUE
63800	
63900		IF(KK.GT.K)GO TO 180
64000	C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
64100		R7=Q(LL)-R5
64200	C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
64300		DO 280 L=KK,K
64400		LL=MM(L)
64500	280	Q(LL)=R7+Q(LL)
64600	180	JJ=JJ2-2
64700		L=JJ2
64800		M=0
64900	C FLAG FOR REST AT START OF LINE
65000	
65100		JJJ=-1
65200	C FLAG FOR 1ST BAR OF LINE 12/77
65300		V=0
65400		ACCI=0
65500		DO 12 J=1,JJ
65600		   R=CODEN(KPN,J,Q,LA)
65700	CC	   IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
65800		   IF(R.EQ.4)GO TO 680
65900		   IF(M)GO TO 780
66000		   IF(R.NE.2)GO TO 780
66100		   IF(KBR.EQ.0)GO TO 12
66200	C  LOOK FOR RESTS AT FRONT OF LINE.
66300		   X=0
66400		   CALL TURN(J,JJ,1,X)
66500		   PGTRN(KBR)=PGTRN(KBR)+X
66600		   M=-1
66700	780	   IF(R.NE.1)GO TO 12
66800		IF(V.NE.Q(LA+3))GO TO 782
66900		IF(JACC)GO TO 781
67000	782	IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
67100		JACC=-1
67200		ACCI=ACCI+.5
67300		V=Q(LA+3)
67400	781	   M=-1
67500		   IF(NOGRCE)GO TO 12
67600	C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
67700	C FOUND A NOTE
67800		   IF(Q(LA+9).GT.0.05)GO TO 12 
67900	C JUMP IF NOT A GRACE NOTE
68000		   R=Q(LA+2)
68100	C  THE STAFF NUM.
68200		   DO 580 LF=J+1,JJ
68300		   	IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
68400			IF(Q(JD+2).NE.R)GO TO 580
68500		   	IF(Q(JD).LT.7)GO TO 580
68600		   	IF(Q(JD+9).EQ.0)GO TO 580
68700	C   CHORD NOTE
68800	  	   	R4=Q(LA+3) 
68900	CC	   	R4=Q(LA+3)-1 
69000		   	R5=Q(JD+3)
69100	C  THE STAFF # IS IN R2
69200		   	R8=RSTFAC(IFIX(R2+1))+.5
69300		   	IF(Q(JD+4).LT.80)R8=R8*2  
69400	C  INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
69500		   	R8=R5-R8
69600	CC	   	R8=R5-R8-1
69700	CCC	   	IF(R4.EQ.R5)GO TO 12
69800		   	IF(R4.NE.R5)GO TO 480
69900	C  GRACE NOTE AT START OF LINE ***** FIX THIS????
70000			DO 880 KE=1,LF-1
70100	880		Q(KPN(KE)+3)=R8
70200	C  MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
70300		   	GO TO 12
70400	480	   	R2=Q(LA+2)
70500		   	R9=R5
70600		   	CALL PTMOVE(Q,KPN)
70700	CC	   	TYPE 9999,Q(J+3),Q(JD+3)
70800	CC9999	   	FORMAT(2F)
70900		   	GO TO 12 
71000	580	   CONTINUE
71100		   GO TO 12
71200	C  ABOVE FOR GRACE NOTE SPACING.
71300	680	   KBR=KBR+1
71400	C BAR LINE COUNTER
71500		   T=Q(LA+3)
71600	C TOTAL SPACE
71700		   X=0
71800		   CALL TURN(J-1,1,-1,X)
71900		   CALL TURN(J+1,JJ,1,X)
72000	222	   PGTRN(KBR)=X
72100	C FINDS PAGE-TURN POSSIBILITIES
72200	C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
72300		   IF(JJJ)RNEXT=RNEXT-6
72400	C JJJ=-1 IF 1ST BAR OF LINE. 12/77
72500		   JJJ=0
72600		   BARS(KBR)=(T-RNEXT+ACCI)*BFAC
72700	C SIZE OF THIS MEASURE + .5*ACCIDENTALS
72800		ACCI=0
72900		   K=J
73000		   RNEXT=T
73100	12	CONTINUE
73200	
73300		IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
73400		RNEXT=RNEXT+3
73500		JJ2=L 
73600	C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
73700	CC???380	LCNT=0
73800	CC???	NDPY=0
73900	C JJ2 IS END OF PNTR DATA
74000		JPQ=KPN(JJ2-1)+1
74100		CALL PUTEXT(NMPG,'PAG')
74200		CALL EXTOUT(RSTFAC,128)
74300		CALL EXTOUT(PN,JJ2)
74400		CALL EXTOUT(Q,JPQ)
74500		CALL FINEXT
74600	
74700		LASTNM=NMPG
74800		NMPG=NMPG+2
74900		IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
75000	C  WILL GO FROM PAGEA TO PAGFZ, ETC. (104)  ADD TO THIS IF NEEDED.
75100		IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
75200		IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
75300	122	ENDLN=RNEXT
75400		END